home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 4 / Apprentice-Release4.iso / Source Code / C / Applications / MacPerl 5.0.3 / MacPerl Source ƒ / Perl5 / ext / Fcntl / Fcntl.c next >
Encoding:
C/C++ Source or Header  |  1995-07-29  |  3.4 KB  |  202 lines  |  [TEXT/MPS ]
  1. #include "EXTERN.h"
  2. #include "perl.h"
  3. #include "XSUB.h"
  4.  
  5. #include <fcntl.h>
  6.  
  7. static int
  8. not_here(s)
  9. char *s;
  10. {
  11.     croak("%s not implemented on this architecture", s);
  12.     return -1;
  13. }
  14.  
  15. static double
  16. constant(name, arg)
  17. char *name;
  18. int arg;
  19. {
  20.     errno = 0;
  21.     switch (*name) {
  22.     case 'F':
  23.     if (strnEQ(name, "F_", 2)) {
  24.         if (strEQ(name, "F_DUPFD"))
  25. #ifdef F_DUPFD
  26.             return F_DUPFD;
  27. #else
  28.             goto not_there;
  29. #endif
  30.         if (strEQ(name, "F_GETFD"))
  31. #ifdef F_GETFD
  32.             return F_GETFD;
  33. #else
  34.             goto not_there;
  35. #endif
  36.         if (strEQ(name, "F_GETLK"))
  37. #ifdef F_GETLK
  38.             return F_GETLK;
  39. #else
  40.             goto not_there;
  41. #endif
  42.         if (strEQ(name, "F_SETFD"))
  43. #ifdef F_SETFD
  44.             return F_SETFD;
  45. #else
  46.             goto not_there;
  47. #endif
  48.         if (strEQ(name, "F_GETFL"))
  49. #ifdef F_GETFL
  50.             return F_GETFL;
  51. #else
  52.             goto not_there;
  53. #endif
  54.         if (strEQ(name, "SETFL"))
  55. #ifdef SETFL
  56.             return SETFL;
  57. #else
  58.             goto not_there;
  59. #endif
  60.         if (strEQ(name, "F_SETLK"))
  61. #ifdef F_SETLK
  62.             return F_SETLK;
  63. #else
  64.             goto not_there;
  65. #endif
  66.         if (strEQ(name, "F_SETLKW"))
  67. #ifdef F_SETLKW
  68.             return F_SETLKW;
  69. #else
  70.             goto not_there;
  71. #endif
  72.         if (strEQ(name, "F_RDLCK"))
  73. #ifdef F_RDLCK
  74.             return F_RDLCK;
  75. #else
  76.             goto not_there;
  77. #endif
  78.         if (strEQ(name, "F_UNLCK"))
  79. #ifdef F_UNLCK
  80.             return F_UNLCK;
  81. #else
  82.             goto not_there;
  83. #endif
  84.         if (strEQ(name, "F_WRLCK"))
  85. #ifdef F_WRLCK
  86.             return F_WRLCK;
  87. #else
  88.             goto not_there;
  89. #endif
  90.         errno = EINVAL;
  91.         return 0;
  92.     } else
  93.       if (strEQ(name, "FD_CLOEXEC"))
  94. #ifdef FD_CLOEXEC
  95.         return FD_CLOEXEC;
  96. #else
  97.         goto not_there;
  98. #endif
  99.     break;
  100.     case 'O':
  101.     if (strnEQ(name, "O_", 2)) {
  102.         if (strEQ(name, "O_CREAT"))
  103. #ifdef O_CREAT
  104.             return O_CREAT;
  105. #else
  106.             goto not_there;
  107. #endif
  108.         if (strEQ(name, "O_EXCL"))
  109. #ifdef O_EXCL
  110.             return O_EXCL;
  111. #else
  112.             goto not_there;
  113. #endif
  114.         if (strEQ(name, "O_NOCTTY"))
  115. #ifdef O_NOCTTY
  116.             return O_NOCTTY;
  117. #else
  118.             goto not_there;
  119. #endif
  120.         if (strEQ(name, "O_TRUNC"))
  121. #ifdef O_TRUNC
  122.             return O_TRUNC;
  123. #else
  124.             goto not_there;
  125. #endif
  126.         if (strEQ(name, "O_APPEND"))
  127. #ifdef O_APPEND
  128.             return O_APPEND;
  129. #else
  130.             goto not_there;
  131. #endif
  132.         if (strEQ(name, "O_NONBLOCK"))
  133. #ifdef O_NONBLOCK
  134.             return O_NONBLOCK;
  135. #else
  136.             goto not_there;
  137. #endif
  138.         if (strEQ(name, "O_NDELAY"))
  139. #ifdef O_NDELAY
  140.             return O_NDELAY;
  141. #else
  142.             goto not_there;
  143. #endif
  144.         if (strEQ(name, "O_RDONLY"))
  145. #ifdef O_RDONLY
  146.             return O_RDONLY;
  147. #else
  148.             goto not_there;
  149. #endif
  150.         if (strEQ(name, "O_RDWR"))
  151. #ifdef O_RDWR
  152.             return O_RDWR;
  153. #else
  154.             goto not_there;
  155. #endif
  156.         if (strEQ(name, "O_WRONLY"))
  157. #ifdef O_WRONLY
  158.             return O_WRONLY;
  159. #else
  160.             goto not_there;
  161. #endif
  162.     } else
  163.       goto not_there;
  164.     break;
  165.     }
  166.     errno = EINVAL;
  167.     return 0;
  168.  
  169. not_there:
  170.     errno = ENOENT;
  171.     return 0;
  172. }
  173.  
  174.  
  175. XS(XS_Fcntl_constant)
  176. {
  177.     dXSARGS;
  178.     if (items != 2) {
  179.     croak("Usage: Fcntl::constant(name,arg)");
  180.     }
  181.     {
  182.     char *    name = (char *)SvPV(ST(0),na);
  183.     int    arg = (int)SvIV(ST(1));
  184.     double    RETVAL;
  185.  
  186.     RETVAL = constant(name, arg);
  187.     ST(0) = sv_newmortal();
  188.     sv_setnv(ST(0), (double)RETVAL);
  189.     }
  190.     XSRETURN(1);
  191. }
  192.  
  193. XS(boot_Fcntl)
  194. {
  195.     dXSARGS;
  196.     char* file = __FILE__;
  197.  
  198.     newXS("Fcntl::constant", XS_Fcntl_constant, file);
  199.     ST(0) = &sv_yes;
  200.     XSRETURN(1);
  201. }
  202.